home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.002 / stk-3 / STk-3.1 / Demos / calc.stklos < prev    next >
Encoding:
Text File  |  1996-02-22  |  2.6 KB  |  81 lines
  1. #!/bin/sh
  2. :;exec /usr/local/bin/stk -f "$0" "$@"
  3. ;;;;
  4. ;;;; c a l c . s t k l o s  --  A very simplistic calculator
  5. ;;;;
  6. ;;;; Copyright ⌐ 1993-1996 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
  7. ;;;; 
  8. ;;;; Permission to use, copy, and/or distribute this software and its
  9. ;;;; documentation for any purpose and without fee is hereby granted, provided
  10. ;;;; that both the above copyright notice and this permission notice appear in
  11. ;;;; all copies and derived works.  Fees for distribution or use of this
  12. ;;;; software or derived works may only be charged with express written
  13. ;;;; permission of the copyright holder.  
  14. ;;;; This software is provided ``as is'' without express or implied warranty.
  15. ;;;;
  16. ;;;;           Author: Erick Gallesio [eg@unice.fr]
  17. ;;;;    Creation date:  6-Apr-1995 18:11
  18. ;;;; Last file update: 18-Sep-1995 14:25
  19.  
  20. (require "Tk-classes")
  21. (define Result   0)
  22.  
  23. (define (get-Screen)
  24.   (string->number (value Screen)))
  25.  
  26. (define (digit? s)
  27.   (or (string->number s) (string=? s ".")))
  28.  
  29. (define execute-action 
  30.   (let ((previous-action "") (Acc 0) (operator +))
  31.     (lambda (str)
  32.       (cond
  33.        ((string=? str "Off")  (exit 0))
  34.        ((string=? str "Sqrt") (set! Result (sqrt (get-screen))))
  35.        ((string=? str "C")    (set! Result 0))
  36.        ((string=? str "/")    (set! operator /))
  37.        ((string=? str "*")    (set! operator *))
  38.        ((string=? str "-")    (set! operator -))
  39.        ((string=? str "+")    (set! operator +))
  40.        ((string=? str "+/-")  (set! Result (- (get-screen))))
  41.        ((string=? str "=")    (set! Result (operator Acc (get-screen))))
  42.        (ELSE               (if (digit? previous-action)
  43.                    (set! Result (string-append (value Screen) str))
  44.                    (begin
  45.                      (set! Acc (get-screen))
  46.                      (set! Result str)))))
  47.     (set! previous-action str))))
  48.  
  49. ;;;;
  50. ;;;; Make the interface
  51. ;;;;
  52. (define Screen (make <Entry> :text-variable 'Result :border-width 3 
  53.                       :relief 'ridge :foreground "Blue"))
  54. (define rows ;; Rows is a vector of 5 frames
  55.   (vector (make <Frame>)(make <Frame>)(make <Frame>)(make <Frame>)(make <Frame>)))
  56.  
  57. (for-each  (let ((count 0))
  58.          (lambda (text)
  59.            (pack (make <Button> 
  60.                :text   text 
  61.                :parent (vector-ref rows (quotient count 4))
  62.                :width  6
  63.                :command (lambda ()  (execute-action text)))
  64.              :side "left" :padx 4 :pady 2)
  65.            (set! count (+ 1 count))))
  66.        '("Off"  "Sqrt"  "C"  "/"
  67.           "7"    "8"    "9"  "*"
  68.           "4"    "5"    "6"  "-"
  69.           "1"    "2"    "3"  "+"
  70.           "0"    "."   "+/-" "="))
  71. ;;;
  72. ;;; And pack its components
  73. ;;;
  74. (pack Screen :expand #t :fill "x" :padx 5 :pady 5 :ipadx 5 :ipady 5)
  75. (for-each (lambda (row) (pack row :expand #t :fill "x"))
  76.       (vector->list rows))
  77.  
  78.  
  79.  
  80.  
  81.